; ORIGINAL: 3dt2.1/examples/drag.scm
; $Id: drag.scm,v 1.4 1997/04/30 20:24:09 jread Exp $
;- drag.scm -------------------------------------------------------
; Pick, highlight and drag an entity.
; (drag #t) turns on dragging. and (drag #f) turns off dragging.
;------------------------------------------------------------------
(define drag
  (lambda (onoff)
    (let ((start-pos (position 0 0 0)) (ent #f))
      (if onoff
          ;; TRUE: Define mouse hooks for dragging entities
          (begin
            (set! mouse-down-hook
                  (lambda (pe)
                    ;; Pick an entity
                    (set! ent (pick:entity pe))
                    (if ent
                        ;; Got one: erase it, remember position and start dragging
                        (begin
                          (roll:mark-start)
                          (if (event:control? pe)
                              ;; We want to make a copy.  This is a little tricky
                              ;; because we do not want the original to get erased
                              ;; when we move the copy.  To prevent this, we first
                              ;; erase the original, make a copy of it, and then
                              ;; redisplay it.  This way, the copy is not originally
                              ;; displayed, so when it is moved, it will not erase
                              ;; the original
                              (begin
                                (entity:erase ent)
                                (let ((new-ent (entity:copy ent)))
                                  (entity:display ent)
                                  (set! ent new-ent)
                                  ))

                              ;; We are not making a copy, so just erase the entity
                              ;; so that we do not see the original as we are draggin
                              ;; it around
                              (entity:erase ent)
                              )
                          (set! start-pos (pick:position pe))
                          (rbd:drag #t ent start-pos)
                          )
                        #f
                        )
                    )
                  )
            (set! mouse-up-hook
                  (lambda (pe)
                    (if ent
                        ;; Stop dragging, transform the entity and redisplay it
                        (begin
                          (rbd:clear)
                          ;; We might have dragged it over a different PART.  See if
                          ;; we need to change the entities part
                          (let ((new-part (view:part (event:view pe))))
                            (if (not (equal? new-part (entity:part ent)))
                                (set! ent (entity:set-part ent new-part))
                                ))
                          (entity:transform ent (transform:translation
                                                  (gvector:from-to start-pos (pick:position pe))))
                          ;; We know that it was displayed, or else we would not have been
                          ;; able to pick it.
                          (entity:display ent)
                          (roll:mark-end)
                          )
                        #f
                        )
                    )
                  )
            )
          ;; FALSE: Turn off drag capability
          (begin
            (set! mouse-down-hook '())
            (set! mouse-up-hook '())
            (rbd:clear)
            )
          )
      ;; Return the new setting
      onoff
      )
    )
  )

